home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / subntx2.zip / SUBDEMO.PRG < prev    next >
Text File  |  1990-05-24  |  9KB  |  299 lines
  1. *┌─────────────────────────────────────────────────────────────────────────┐
  2. *│                                                                         │
  3. *│ Program:  Subdemo.prg                                                   │
  4. *│                                                                         │
  5. *│                                                                         │
  6. *│ Compile:  CLIPPER SUBDEMO                                               │
  7. *│ Link:     LINK /NOE subdemo,,,clipper extend subntxd                    │
  8. *│                                                                         │
  9. *└─────────────────────────────────────────────────────────────────────────┘
  10.  
  11. SET SCOREBOARD OFF
  12.  
  13. PUBLIC mainscrn
  14.  
  15. wait_for = 99
  16. no_erase = 0
  17.  
  18. public alkey[3] 
  19. public aukey[3] 
  20. public awcard[3]
  21. public axproc[3]
  22. public atries[3]
  23.  
  24. alkey[1]  = "*              "
  25. aukey[1]  = "Brink          "
  26. awcard[1] = "*a*            "
  27. axproc[1] = .T.
  28. atries[1] = -1
  29.  
  30. alkey[2]  = "C              "
  31. aukey[2]  = "D              "
  32. awcard[2] = "*1990??15*     "
  33. axproc[2] = .F.
  34. atries[2] = -1
  35.  
  36. alkey[3]  = "L              "
  37. aukey[3]  = "Li             "
  38. awcard[3] = "*              "
  39. axproc[3] = .T.
  40. atries[3] = -1
  41.  
  42.  
  43.  
  44. DO MAKESCRN
  45. SAYMSG("                       SUBNTX() Demonstration Program","",no_erase)
  46.  
  47.  
  48. IF ! FILE("SUBDEMO.DBF")
  49.     @ 21,24 SAY      "┌───────────────────────────────┐"
  50.     @ ROW()+1,24 SAY "│                               │"
  51.     @ ROW()+1,24 SAY "│  SUBDEMO.DBF Not Found......  │"
  52.     @ ROW()+1,24 SAY "│                               │"
  53.     @ ROW()+1,24 SAY "└───────────────────────────────┘"
  54.     QUIT
  55. ENDIF
  56.  
  57.  
  58. @ 5,20 SAY       "┌────────────────────────────────────────┐"
  59. @ ROW()+1,20 SAY "│                                        │"
  60. @ ROW()+1,20 SAY "│               Note:                    │"
  61. @ ROW()+1,20 SAY "│                                        │"
  62. @ ROW()+1,20 SAY "│  - This demo requires approximately    │"
  63. @ ROW()+1,20 SAY "│    425K of diskspace to run.           │"
  64. @ ROW()+1,20 SAY "│                                        │"
  65. @ ROW()+1,20 SAY "│  - Also this creates two files:        │"
  66. @ ROW()+1,20 SAY "│    SUBDEMO.NTX and _SUBTMP.DBF         │"
  67. @ ROW()+1,20 SAY "│                                        │"
  68. @ ROW()+1,20 SAY "│                                        │"
  69. @ ROW()+1,20 SAY "│    Do you want to continue (Y/N)?      │"
  70. @ ROW()+1,20 SAY "│                                        │"
  71. @ ROW()+1,20 SAY "└────────────────────────────────────────┘"
  72.  
  73.  
  74. yn = "Y"
  75. @ ROW()-2,56 GET yn PICTURE "!" VALID yn$"YN"
  76. READ                      
  77.  
  78. IF yn != "Y" .OR. lastkey() == 27
  79.     CLEAR
  80.     QUIT
  81. ENDIF
  82.  
  83.  
  84.  
  85. RESTORE SCREEN FROM mainscrn
  86. USE SUBDEMO
  87. IF lastrec() < 75
  88.     DO EXPAND_DBF
  89. ENDIF
  90.  
  91. IF ! FILE("SUBDEMO.NTX")
  92.     saymsg(" STAND BY WHILE INDEXING.......","",no_erase)
  93.     INDEX ON LNAME+FNAME+DTOS(ORDERDATE) TO SUBDEMO
  94.     RESTORE SCREEN FROM mainscrn
  95. ENDIF
  96.  
  97. * Define fields for browsing
  98. PUBLIC flds[5]
  99. flds[1]="rec"
  100. flds[2]="fname"
  101. flds[3]="lname"
  102. flds[4]="orderdate"
  103. flds[5]="position"
  104. t = 10
  105. l = 05
  106. b = 20
  107. r = 75
  108.  
  109.  
  110.  
  111.  
  112. * All records                                               
  113. RESTORE SCREEN FROM mainscrn  
  114. saymsg(" To First browse with all records.........Press any key.......",1,wait_for)
  115. set index to SUBDEMO
  116. go top
  117. seek "Moon"
  118. saymsg(" Browsing all records.....Press any key when finished.....",1,no_erase)
  119. browse()                                          
  120.  
  121.  
  122.  
  123.  
  124. * Filter method
  125. saymsg(" Next is with a filter......Press any key......",1,wait_for)
  126. go top
  127. seek "Moon"
  128. set filter to lname = "Moon"                                 
  129. saymsg(" Notice when you move past boundaries it takes a VERY LONG time....",1,no_erase)
  130. saymsg(" (probably more than a minute)",2,no_erase)
  131. browse()                                                                        
  132. set filter to
  133.  
  134.  
  135.  
  136.  
  137.  
  138. * Subindex method
  139. set index to
  140. saymsg(" Next is with the SubNtx() method.",1,no_erase)
  141. saymsg(" Press any key to begin extracting the subset from the main index.....",2,wait_for)
  142. RESTORE SCREEN FROM mainscrn
  143. num = subntx( "SUBDEMO.NTX", "_SUB.NTX", "Moo" )
  144. RESTORE SCREEN FROM mainscrn
  145. set index to _sub 
  146. saymsg(" Browsing small subset with sub.ntx.......Press any key when finished.....",1,no_erase)
  147. saymsg("",2,no_erase)
  148. browse()
  149. set index to
  150. erase _sub.ntx
  151.  
  152.  
  153.  
  154. FOR i = 1 to 3   && max for demo
  155.  
  156.     RESTORE SCREEN FROM mainscrn
  157.     saymsg(" Now try some of the other parameters.....",1,no_erase)
  158.  
  159.     set index to
  160.  
  161.     * Store different examples for each time
  162.     lkey  = alkey[i]
  163.     ukey  = aukey[i]
  164.     wcard = awcard[i]
  165.     xproc = axproc[i]
  166.     tries = atries[i]                       
  167.  
  168.     @ 5,4 say "<code> = SubNtx( main, sub, lkey [,ukey [,wcard [, xproc [,tries ]]]] )"
  169.  
  170.     @ 09, 00, 24 ,79 box "┌─┐│┘─└│ " 
  171.     @ 10, 01 say "lkey..:                 ....Partial lower key range (required)"
  172.     @ 11, 01 say "ukey..:                 ....Partial upper key range (optional)"
  173.     @ 12, 01 say "wcard.:                 ....Wild Card Pattern (optional)"
  174.     @ 13, 01 say "xproc.:                 ....Use predefined Clipper Procedure* (optional)"
  175.     @ 14, 01 say "tries.:                 ....Number of tries to lock main index file (optional)"
  176.  
  177.     @ 16, 01 say "   * Note: The predfined Clipper function for this demo is:"
  178.     @ 17, 01 say "           recno() > 1800 .AND. recno() < 2000"
  179.  
  180.     @ 19, 01 say "   * Here's one records index key to help guide you:"
  181.     @ 20, 01 say "           Offset...........:12345678901234567890123456789012345678"
  182.     @ 21, 01 say "           Key..............:Moon           Skip           19900101"
  183.  
  184.     @ 23, 01 say "           Contents.........:(LNAME=15)  +  (FNAME=15)  +  DTOS(orderdate)"
  185.  
  186.  
  187.     @ 10, 09 get lkey
  188.     @ 11, 09 get ukey
  189.     @ 12, 09 get wcard
  190.     @ 13, 09 get xproc 
  191.     @ 14, 09 get tries picture "999"
  192.     READ
  193.     IF LASTKEY() == 27
  194.         EXIT
  195.     ENDIF
  196.  
  197.     lkey  = trim(lkey)
  198.     ukey  = trim(ukey)
  199.     wcard = trim(wcard)
  200.     xproc = iif(xproc==.t.,.t.,.f.)
  201.     tries = iif(tries<1,-1,tries)
  202.  
  203.     saymsg(" ",1,no_erase)
  204.     saymsg(" Press any key to begin extracting the subset from the main index.....",2,wait_for)
  205.     RESTORE SCREEN FROM mainscrn
  206.  
  207.     num = subntx( "subdemo.ntx", "_sub.ntx", lkey, ukey, wcard, xproc, tries )
  208.  
  209.     RESTORE SCREEN FROM mainscrn
  210.     set index to _sub 
  211.     saymsg(" Browsing "+str(num,4)+" extracted records with sub.ntx",1,no_erase)
  212.     saymsg(" Press any key when finished....",2,no_erase)
  213.     browse()
  214.     set index to
  215.     erase _sub.ntx
  216.  
  217. NEXT
  218.  
  219. close databases
  220. RESTORE SCREEN FROM mainscrn
  221.  
  222. IF i == 4
  223.     saymsg("Sorry you'll have to start the demo over since it's limited to a total",1,no_erase)
  224.     saymsg("of 5 calls per program execution. (Or send in the order form......<g>)",2,no_erase)
  225. ELSE
  226.     saymsg(" That ends the demo... ",1,no_erase)
  227. ENDIF
  228. @ 23,0 SAY ""
  229. QUIT
  230.  
  231.  
  232.  
  233. FUNCTION browse
  234.     @ t-1,l-1 clear to b+1,r+1
  235.     @ t-1,l-1 to b+1,r+1 double
  236.     dbedit(t,l,b,r,flds)                                          
  237.     RESTORE SCREEN FROM mainscrn
  238. return ""
  239.  
  240.  
  241. PROCEDURE _subeval       && This is just a sample _subeval() 
  242.     rnum = subrec()
  243.     * key = subkey()
  244.     * go rnum
  245.     if rnum > 1800 .and. rnum < 2000   && typical condition or macro
  246.         reteval(.T.)
  247.     else
  248.         reteval(.F.)
  249.     endif
  250. RETURN 
  251.  
  252.  
  253. PROCEDURE MAKESCRN
  254.     setcolor("W/B,+N/W")
  255.     @ 00,00,24,79 box replicate(chr(177),9)
  256.     @ 00,00,03,79 box "┌─┐│┘─└│ "
  257.     SAVE SCREEN TO mainscrn
  258. return
  259.  
  260.  
  261.  
  262.  
  263.  
  264. PROCEDURE EXPAND_DBF
  265.     saymsg(" STAND BY WHILE EXPANDING SUBDEMO.DBF....","",0)
  266.     COPY TO _SUBTMP
  267.     FOR i = 1 to 49
  268.         APPEND FROM _SUBTMP
  269.     NEXT
  270.     ERASE _SUBTMP.DBF
  271.     REPLACE ALL REC WITH RECNO()
  272.     RESTORE SCREEN FROM mainscrn
  273. RETURN
  274.  
  275.  
  276.  
  277. ********
  278. FUNCTION SAYMSG
  279. ********
  280.     * Says message on <xline>, and waits  <xpause> secs, unless keypressed
  281.     *  If xpause = 0, it returns without clearing
  282.     *  If xpause = 99 it waits for a keypress
  283.     PARAMETERS xmsg,xline,xpaus